!--------------------------------------------------------------------------------------------
! FileName:     gol_serial_nbym.F90
! 
! Compile :     $ gfortran -g -o gol_serial_nbym.x -Wall gol_serial_nbym.F90
!
! Run     :     $ gol_serial_nbym.x
!
! Be careful:   1. GridX, GridY must be same size. (ex) 10x10, 20x20, 100x100
!               2. To do preprocessor, .F90 is required.
!
! Tab size:     8
! Version :     1.03
!
! Updated by    2011. 11. 01
!--------------------------------------------------------------------------------------------

PROGRAM gol_serial_nbym
IMPLICIT NONE
        INTEGER i, j, k
        INTEGER, PARAMETER ::   nGridXSize=20, nGridYSize=20, nSteps=100, nSleep=3
        INTEGER nLiveCell
        
        INTEGER, DIMENSION(:, :), ALLOCATABLE                   :: gol_buf
        
        ! Memory Allocation
        ALLOCATE(gol_buf(0:nGridXSize, 0:nGridYSize))
        
        ! set to 0 
        DO i=0, nGridXSize-1
                DO j=0, nGridYSize-1
                        gol_buf(i,j) = 0
                END DO
        END DO
        
        CALL getRandomValue(gol_buf, nGridXSize, nGridYSize)
        CALL showGridState(gol_buf, nGridXSize, nGridYSize)
        WRITE(*, *)     

        ! -----------------------------------------------------------------------------------------------------
        ! Main Loop : time steps
        ! -----------------------------------------------------------------------------------------------------
        DO i=1, nSteps

                ! Do work at the my own grid cell
                CALL calEvolution(gol_buf, nGridXSize, nGridYSize)

                WRITE(*, *)
                WRITE(*, '(A, I6, A, I6)') 'msg> nStep = ', i, '/', nSteps
                WRITE(*, *)
                CALL showGridState(gol_buf, nGridXSize, nGridYSize)
        
                nLiveCell = 0
        
                DO j=0, nGridXSize-1
                        DO k=0, nGridYSize-1
                                nLiveCell = nLiveCell + gol_buf(j, k)
                        END DO
                END DO
                        
                WRITE(*, *)
                WRITE(*, '(A, I4)') 'msg> nLiveCell = ', nLiveCell
        
                WRITE(*, '(A, I2, A)') 'msg> Wait a ', nSleep, ' sec'
                CALL Sleep(nSleep)
        END DO
        ! -----------------------------------------------------------------------------------------------------
        ! End of Main Loop : time steps
        ! -----------------------------------------------------------------------------------------------------

        ! Memory Free
        DEALLOCATE(gol_buf)

!------------------------------------------------------------
CONTAINS
SUBROUTINE getRandomValue(gol_buf, nGridXSize, nGridySize)
INTEGER nGridXSize, nGridYSize
INTEGER, DIMENSION(0:nGridXSize, 0:nGridYSize)          :: gol_buf

        INTEGER ii, jj
        
        !CALL RANDOM_SEED()
        
        CALL init_random_seed()
        
        DO ii=0, nGridXSize-1
                DO jj=0, nGridYSize-1
                        gol_buf(ii, jj) = MOD(IRAND(), 2)       ! Get random # (0 ~ 1) 
                END DO  
        END DO
END SUBROUTINE

SUBROUTINE showGridState(gol_buf, nGridXSize, nGridYSize)
INTEGER nGridXSize, nGridYSize
INTEGER, DIMENSION(0:nGridXSize, 0:nGridYSize)          :: gol_buf
        INTEGER ii, jj
        
        WRITE(*, 400, advance='no')     '   '
        
        DO ii=0, nGridYSize-1
                WRITE(*, 100, advance='no')     ii
        END DO
        
        WRITE(*, *)                             ! new line
        WRITE(*, 400, advance='no')     '   '
        
        Do ii=0, nGridYSize-1
                WRITE(*, 200, advance='no')     '--'
        END DO
        
        WRITE(*, *)                             ! new line
                
100     FORMAT(I2, X)
200     FORMAT(A2, X)

        DO ii=0, nGridXSize-1
                WRITE(*, 300, advance='no')     ii, '|'
                
                DO jj=0, nGridYSize-1
                        IF (gol_buf(ii, jj) == 0) THEN
                                WRITE(*, 400, advance='no')     ' - '
                        ELSE IF (gol_buf(ii, jj) == 1) THEN
                                WRITE(*, 400, advance='no')     ' # '
                        ELSE
                                WRITE(*, 400, advance='no') ' $ '
                        END IF
                END DO
                WRITE(*, *)                             ! new line
        END DO 

300     FORMAT(I2, A)
400     FORMAT(A)
END SUBROUTINE

FUNCTION getNeighborCount(ii, jj, tmp_buf, nGridXSize, nGridYSize)
INTEGER ii, jj, nGridXSize, nGridYSize
INTEGER, DIMENSION(0:nGridXSize, 0:nGridYSize)          :: tmp_buf
INTEGER getNeighborCount
        INTEGER a, b, c, d, e, f, x
        INTEGER count

        a = jj - 1              
        b = jj                  
        c = jj + 1              
        d = ii - 1              
        e = ii                  
        f = ii + 1              
        count = 0
        
        DO x=0, 7
                SELECT CASE(x)
                        CASE (0)
                                IF (a >=0 .AND. d >= 0)                 count = count + tmp_buf(a, d)
                        CASE (1)
                                IF (a >= 0)                             count = count + tmp_buf(a, e)
                        CASE (2)
                                IF (a >= 0 .AND. f < nGridYSize)        count = count + tmp_buf(a, f)
                        CASE (3)
                                IF (f < nGridYSize)                     count = count + tmp_buf(b, f)
                        CASE (4)
                                IF (c < nGridXSize .AND. f < nGridYSize)count = count + tmp_buf(c, f)
                        CASE (5)
                                IF (c < nGridXSize)                     count = count + tmp_buf(c, e)
                        CASE (6)
                                IF (c < nGridXSize .AND. d >= 0)        count = count + tmp_buf(c, d)
                        CASE (7)
                                IF (d >= 0)                             count = count + tmp_buf(b, d)
                END SELECT
        END DO  

        getNeighborCount = count
END FUNCTION

SUBROUTINE calEvolution(gol_buf, nGridXSize, nGridYSize)
INTEGER nGridXSize, nGridYSize
INTEGER, DIMENSION(0:nGridXSize, 0:nGridYSize)                  :: gol_buf
        INTEGER ii, jj
        INTEGER, DIMENSION(0:nGridXSize, 0:nGridYSize)          :: tmp_buf
        INTEGER nNeighbors
        
        ! Copy from gol-buf to tmp_buf
        ! DO ii=0, nGridXSize-1
        !       DO jj=0, nGridYSize-1
        !               tmp_buf(ii, jj) = gol_buf(ii, jj)
        !       END DO
        ! END DO

        ! Copy from gol-buf to tmp_buf
        tmp_buf(0:nGridXSize, 0:nGridYSize) = gol_buf(0:nGridXSize, 0:nGridYSize)
        
        DO ii=0, nGridXSize-1
                DO jj=0, nGridYSize-1
                        nNeighbors = getNeighborCount(jj, ii, tmp_buf, nGridXSize, nGridYSize)
                        
                        IF (nNeighbors == 2) THEN               ! no change
                                ! gol_buf(ii, jj) = gol_buf(ii, jj)
                        ELSE IF (nNeighbors == 3) THEN          ! alive
                                gol_buf(ii, jj) = 1
                        ELSE                                    ! dead
                                gol_buf(ii, jj) = 0
                        END IF
                END DO
        END DO
END SUBROUTINE

SUBROUTINE init_random_seed()
            INTEGER :: i, n, clock
            INTEGER, DIMENSION(:), ALLOCATABLE :: seed
          
            CALL RANDOM_SEED(size = n)
            ALLOCATE(seed(n))
          
            CALL SYSTEM_CLOCK(COUNT=clock)
          
            seed = clock + 37 * (/ (i - 1, i = 1, n) /)
            CALL RANDOM_SEED(PUT = seed)
          
            DEALLOCATE(seed)
END SUBROUTINE

!------------------------------------------------------------
END
